home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d14
/
baswind8.arc
/
BARMENU.SUB
next >
Wrap
Text File
|
1990-09-14
|
20KB
|
608 lines
'
'
'******************************************************************************
' Function : BARMENU *
' *
' Purpose: *
' *
' *
' Results: *
' *
' Usage : *
' *
' *
' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan *
' Date Modified: - : - : *
'-----------------------------------------------------------------------------*
' NOTE: *
'******************************************************************************
' *
' SUB PROGRAM NAME (PARAMETERS) STATIC/RECURSIVE *
'-----------------------------------------------------------------------------*
' *
SUB BARMENU(MENULINE$,MENUFG%,MENUBG%,BLKSIZE%,BLKNUM%,MAXSIZE%(1),MAXITEMS%(1),ITEMS$(2),MENUSLCT%,ITEMSLCT%,RETURN.CODE%) STATIC
DEFINT A-Z 'make all short intergers by default
REM $DYNAMIC
DIM SCR(2000)
DIM BAR.SCR(256) 'storage for bar menu line
REM $STATIC
RETURN.CODE%=0
MAKEWIND.RETURN.CODE=0
RESTWIND.RETURN.CODE=0
SAVEWIND.RETURN.CODE=0
VIDEO.RETURN.CODE=0
ITEMS.MIN=LBOUND(ITEMS$,1) 'make the code independant of callers BASE OPTION
ITEMS.MAX=UBOUND(ITEMS$,1)
'
' need to add code to insure ALL arrays use same UBOUND
'
MENU.BASE=1-ITEMS.MIN
MENU.MAXITEMS%=0
MENU=1 'start with first menu
OLD.MENU=MENU
MSELECT=1
OLD=1
MENUROW=2 'bar menu goes on this line
MENUCOL=2
MENU.TOP.ROW=0 'co-ordinates for pop-down menu, off bar
MENU.TOP.LEFT.COL=0
MENU.BOTTOM.ROW=0
MENU.BOTTOM.RIGHT.COL=0
TEMP.ITEM$=STRING$(255," ")
'
BUTTONS%=0 'assume no mouse support avail
CALL MMCHECK(BUTTONS%) 'see if mouse support avail
GOSUB BARMENU.MMCURSORON
MOUSECOL=0 'locate the mouse cursor in upper
MOUSEROW=0 'left top corner of screen
CALL MMSETLOC(MOUSECOL,MOUSEROW)
FIRST.TIME=-1
GOSUB BARMENU.MMCURSOROFF
PRESATTR=SCREEN(MENUROW,MENUCOL,1) 'get present attribute of menu bar
ATTR=(MENUBG% AND 7)*16+MENUFG% 'turn on menu bar
CALL FASTPRT(MENULINE$,MENUROW,MENUCOL,ATTR,VIDEO.RETURN.CODE)
GOSUB BARMENU.BOX 'display the barmenu box for the first barmenu selection
GOTO BARMENU.LOOPX
'
BARMENU.LOOP:
GOSUB BARMENU.PROCESS 'turnoff Position of Selection Marker
BARMENU.LOOPX:
GOSUB BARMENU.TON 'turn on position of Selection Marker
GOSUB BARMENU.PRESS 'Get KeyPress
IF KP$=CHR$(13) THEN 'if ENTER pressed , a selection was made
GOTO BARMENU.DONE 'so we are thru
END IF
IF KP$=CHR$(27) THEN 'was ESC pressed?
GOTO BARMENU.DONE2
END IF
GOTO BARMENU.LOOP
'
'Check for KeyPress and sound error if not UP ARROW, DOWN ARROW, LEFT ARROW, RIGHT ARROW, or RETURN
'
BARMENU.PRESS:
GOSUB BARMENU.MMCURSORON
CALL MMCLICK(LFT%,RGT%) 'flush any mouse clicks
GOSUB BARMENU.GET.PRESS 'generalized routine for kybd and mouse
IF KP$="" THEN 'anything to do?
GOTO BARMENU.PRESS 'NO
END IF
IF LEN(KP$)=2 THEN 'an Extended function key pressed?
GOTO BARMENU.DOWN
END IF
IF KP$=CHR$(13) THEN 'ENTER pressed, a menu item was selected?
RETURN
END IF
IF KP$=CHR$(27) THEN 'was ESC pressed?
MENUSLCT%=0 'cancel ALL selections!
ITEMSLCT%=0
RETURN
END IF
GOSUB BARMENU.FIND.OPTION 'was the first char of an selection pressed?
IF MSELECT<>SAVE.MSELECT THEN 'was a new selection was this letter found?
RETURN
END IF
GOSUB BARMENU.SOUNDOFF
GOTO BARMENU.PRESS
'
'Process DOWN ARROW KeyPress
'
BARMENU.DOWN:
IF ASC(RIGHT$(KP$,1))<>80 THEN 'was cursor down pressed?
GOTO BARMENU.UP
END IF
MSELECT=MSELECT+1 'select the next item in the menu
IF ITEMS$(MENU-MENU.BASE,MSELECT-MSLECT.BASE)=STRING$(MAXSIZE%(MENU-MENU.BASE),196) THEN
MSELECT=MSELECT+1
END IF
'
' are we past the end of the pop-down menu items?
'
IF MSELECT > MENU.MAXITEMS% THEN
MSELECT=1 'start back with the first pop-down menu item
END IF
RETURN
'
'Process UP ARROW KeyPress
BARMENU.UP:
IF ASC(RIGHT$(KP$,1))<>72 THEN 'was cursor up pressed?
GOTO BARMENU.OTHER
END IF
MSELECT=MSELECT-1 'select the previous item in the menu list
'
'did we go past the start of the pop-down menu items
'
IF ITEMS$(MENU-MENU.BASE,MSELECT-MENU.BASE)=STRING$(MAXSIZE%(MENU-MENU.BASE),196) THEN
MSELECT=MSELECT-1
END IF
IF MSELECT < 1 THEN
MSELECT=MENU.MAXITEMS% 'select the last item in the pop-down list
END IF
RETURN
'
'Process RIGHT ARROW KeyPress
BARMENU.OTHER: 'was cursor right pressed?
IF ASC(RIGHT$(KP$,1))=77 THEN
MENU=MENU+1 'select the next bar menu item
IF MENU > BLKNUM% THEN 'did we go past the end of the bar menu items
MENU = 1 'Yes, loop back around to the first bar menu item
GOSUB BARMENU.NEWMENU
RETURN
ELSE
GOSUB BARMENU.NEWMENU
RETURN
END IF
END IF
'
'Process LEFT ARROW KeyPress
IF ASC(RIGHT$(KP$,1))=75 THEN 'was cursor left pressed?
MENU=MENU-1 'select the previous bar menu item
IF MENU < 1 THEN 'did we go past the start of the bar menu items
MENU = BLKNUM% 'yes, loop around to the last bar menu item
GOSUB BARMENU.NEWMENU
RETURN
ELSE
GOSUB BARMENU.NEWMENU
RETURN
END IF
END IF
GOSUB BARMENU.SOUNDOFF 'NOt a valid extended function key!
GOTO BARMENU.PRESS
'
'turn off present selection
BARMENU.PROCESS:
IF OLD=0 THEN 'anything selected yet?
RETURN
END IF
GOSUB BARMENU.MMCURSOROFF
' MENU.ITEM$=ITEMS$((MENU-MENU.BASE)+ITEMS.MIN,(OLD-OLD.BASE)+ITEMS.MIN)
' IF LEN(MENU.ITEM$)< LENGTH.MENU.ITEM THEN_
' MENU.ITEM$=MENU.ITEM$+STRING$(LENGTH.MENU.ITEM-LEN(MENU.ITEM$)," ")
ROW=((MENU.TOP.ROW-1)+OLD) 'this is where this pop-down menu item is located
COL=MENU.TOP.LEFT.COL
ATTR=(MENUBG% AND 7)*16+MENUFG% 'turn off highlighting for this menu item
CALL FASTPRT(MENU.ITEM$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
RETURN
'
'Turn on new selection
BARMENU.TON:
IF MSELECT=0 THEN 'anything selected yet?
GOTO BARMENU.TON.NEWOLD
END IF
GOSUB BARMENU.MMCURSOROFF
MENU.ITEM$=ITEMS$(MENU-MENU.BASE,MSELECT-MENU.BASE)
IF LEN(MENU.ITEM$)< LENGTH.MENU.ITEM THEN
MENU.ITEM$=MENU.ITEM$+STRING$(LENGTH.MENU.ITEM-LEN(MENU.ITEM$)," ")
END IF
ROW=((MENU.TOP.ROW-1)+MSELECT) 'this is where the menu item is located
COL=MENU.TOP.LEFT.COL
ATTR=(MENUFG% AND 7)*16+MENUBG% 'highlight this popdown menu item
CALL FASTPRT(MENU.ITEM$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
' IF FIRST.TIME THEN
IF MSELECT<>OLD THEN 'did the selection change (cursor up or down)
MOUSEROW=(ROW-1)*8 'if so, put the mouse cursor on the new selection
MOUSECOL=(COL-1)*8
CALL MMSETLOC(MOUSECOL,MOUSEROW)
FIRST.TIME=0
END IF
' END IF
BARMENU.TON.NEWOLD:
OLD=MSELECT 'make the current selection the "OLD" one now
RETURN
'
'
BARMENU.NEWMENU:
MSELECT=0 'reinitialize selections for a new menu
OLD=0
OLD.MENU=MENU 'this is the current bar menu item
GOSUB BARMENU.MMCURSOROFF
WINSEG=0
WINOFF=0
WINSEG=VARSEG(SCR(0))
WINOFF=VARPTR(SCR(0))
CALL RESTWIND(WINDOW.TOP.ROW,WINDOW.TOP.LEFT.COL,WINDOW.BOT.ROW,WINDOW.BOT.RIGHT.COL,WINSEG,WINOFF,RESTWIND.RETURN.CODE)
WINSEG=0
WINOFF=0
WINSEG=VARSEG(BAR.SCR(0))
WINOFF=VARPTR(BAR.SCR(0))
CALL RESTWIND(2,1,2,80,WINSEG,WINOFF,RESTWIND.RETURN.CODE) 'restore the bar menu line
'
BARMENU.BOX:
'
'Calculate the maximum items to be displayed in this pop-down window
'
MENU.MAXITEMS%=MAXITEMS%(MENU-MENU.BASE)
'
'calculate the pop-down menu windows upper left row/column co-ordinates
'
MENU.TOP.ROW=MENUROW+2
MENU.TOP.LEFT.COL=((MENU-1)*BLKSIZE%)+MENUCOL+1
'
'calculate the pop-down menu windows lower right row/column co-ordinates
'
MENU.BOTTOM.ROW=(MENU.TOP.ROW+MENU.MAXITEMS%)-1
LENGTH.MENU.ITEM=0
MENU.BOTTOM.RIGHT.COL=0
'find the longest menu item in this menu
FOR K=ITEMS.MIN TO ITEMS.MIN+MENU.MAXITEMS%
MENU.ITEM$=ITEMS$(MENU-MENU.BASE,K)
IF LEN(MENU.ITEM$)>MENU.BOTTOM.RIGHT.COL THEN
MENU.BOTTOM.RIGHT.COL=LEN(MENU.ITEM$)
END IF
NEXT
LENGTH.MENU.ITEM=MENU.BOTTOM.RIGHT.COL 'this is the size of the longest menu item
MENU.BOTTOM.RIGHT.COL=MENU.TOP.LEFT.COL+(MENU.BOTTOM.RIGHT.COL-1) 'SO, the box for this menu will be at least this big
'save the area that this menu window will occupy
WINDOW.TOP.ROW=MENU.TOP.ROW-1 'adjust row and cols to allow for window frame
WINDOW.BOT.ROW=MENU.BOTTOM.ROW+1
WINDOW.TOP.LEFT.COL=MENU.TOP.LEFT.COL-1
WINDOW.BOT.RIGHT.COL=MENU.BOTTOM.RIGHT.COL+1
WINSEG=0
WINOFF=0
WINSEG=VARSEG(BAR.SCR(0))
WINOFF=VARPTR(BAR.SCR(0))
CALL SAVEWIND(2,1,2,80,WINSEG,WINOFF,SAVEWIND.RETURN.CODE)
WINSEG=0
WINOFF=0
WINSEG=VARSEG(SCR(0))
WINOFF=VARPTR(SCR(0))
CALL SAVEWIND(WINDOW.TOP.ROW,WINDOW.TOP.LEFT.COL,WINDOW.BOT.ROW,WINDOW.BOT.RIGHT.COL,WINSEG,WINOFF,SAVEWIND.RETURN.CODE)
ROW=MENUROW 'REVERSE ATTRIBUTE FOR MENU LINE BLOCK
COL=((MENU-1)*BLKSIZE%)+MENUCOL
BEGWORD=COL
REVWORD$=""
'
BARMENU.LOOPWRD2:
WHILE LEN(REVWORD$)<BLKSIZE%
REVWORD$=REVWORD$+CHR$(SCREEN(MENUROW,BEGWORD,0))
BEGWORD=BEGWORD+1
WEND
COL=COL
ATTR=(MENUFG% * 16)+MENUBG%
CALL FASTPRT(REVWORD$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
'
'Locate mouse cursor in the middle of currently high-lighted bar menu item
'
MOUSEROW=(ROW-1)*8
MOUSECOL=(BLKSIZE%\2)+COL-(MENUCOL-1)
MOUSECOL=(MOUSECOL-1)*8
CALL MMSETLOC(MOUSECOL,MOUSEROW)
'display pop-down menu for the currently
FRAME=4
GROW=0
SHADOW=0
LABEL$=""
CALL MAKEWIND(MENU.TOP.ROW,MENU.TOP.LEFT.COL,MENU.BOTTOM.ROW,MENU.BOTTOM.RIGHT.COL,FRAME,MENUFG%,MENUBG%,GROW,SHADOW,LABEL$,MAKEWIND.RETURN.CODE)
'Place Menu Items in Window
FOR J=1 TO MENU.MAXITEMS%
MENU.ITEM$=ITEMS$(MENU-MENU.BASE,J-MENU.BASE)
'
' Make all the menus items the same length
'
IF LEN(MENU.ITEM$)< LENGTH.MENU.ITEM THEN
MENU.ITEM$=MENU.ITEM$+STRING$(LENGTH.MENU.ITEM-LEN(MENU.ITEM$)," ")
END IF
ROW=(MENU.TOP.ROW-1)+J
ATTR=(MENUBG% AND 7)*16+MENUFG%
CALL FASTPRT(MENU.ITEM$,ROW,MENU.TOP.LEFT.COL,ATTR,VIDEO.RETURN.CODE)
NEXT
GOSUB BARMENU.MMCURSORON
MSELECT=1 'indicate that first pop-down menu item is current one
OLD=1
RETURN
'
'
BARMENU.FIND.OPTION:
SAVE.MSELECT=MSELECT 'save the currently selected menu item
TEMP.MSELECT=MSELECT
FIRST.CHAR$=KP$ 'this is the character we want to match on
COUNT=0 'keep count of number of items matched against
BARMENU.FIND.LOOP:
TEMP.MSELECT=TEMP.MSELECT+1 'look at the next menu item
IF TEMP.MSELECT>MENU.MAXITEMS% THEN 'did we go past the end of the menu
TEMP.MSELECT=1 'yes, loop back to the first item
END IF
COUNT=COUNT+1 'we have matched against this many items so far
IF COUNT>MENU.MAXITEMS% THEN 'have we looked at all the menu items
RETURN 'yes, and a match was not found
END IF
MID$(TEMP.ITEM$,1)=ITEMS$(MENU-MENU.BASE,TEMP.MSELECT-MENU.BASE)
LEN.TEMP.ITEM=LEN(ITEMS$(MENU-MENU.BASE,TEMP.MSELECT-MENU.BASE))
'
'Check this menu item to see if its first character matches
'
'Scan over any leading spaces in the menu item
'
FOR I=1 TO LEN.TEMP.ITEM
IF MID$(TEMP.ITEM$,I,1)<>" " THEN
IF MID$(TEMP.ITEM$,I,1)=FIRST.CHAR$ THEN
MSELECT=TEMP.MSELECT 'a match was found!
RETURN
ELSE
GOTO BARMENU.FIND.LOOP
END IF
END IF
NEXT
GOTO BARMENU.FIND.LOOP 'no match found, keep looking
'
'
BARMENU.GET.PRESS:
IF BUTTONS%=0 THEN 'is a mouse installed?
GOTO BARMENU.GET.INKEY 'NO, so only check keyboard
END IF
CALL MMGETLOC(MOUSECOL,MOUSEROW) 'get the current mouse screen cursor location
MOUSECOL=(MOUSECOL\8)+1 'convert to 80x25 co-ordinates
MOUSEROW=(MOUSEROW\8)+1
IF MOUSEROW<>MENUROW THEN 'is mouse on the menu line
GOTO BARMENU.CHECK.IF.INBOX 'no, is it in a menu box
END IF
CALL MMCLICK(LFT%,RGT%) 'flush the mouse clicks
TEMP.MENU=((MOUSECOL-MENUCOL)\BLKSIZE%)+1 'where is the mouse cursor on the menu line
IF TEMP.MENU>BLKNUM% THEN 'is it past the end of the bar menu items
GOTO BARMENU.GET.INKEY 'yes
END IF
MENU=TEMP.MENU '
IF MENU<>OLD.MENU THEN 'are we on the same bar menu item as before
GOSUB BARMENU.NEWMENU 'NO, make the drop-down menu for this new bar menu item
GOSUB BARMENU.TON 'turn on position of Selection Marker
END IF
GOTO BARMENU.GET.INKEY
'
BARMENU.CHECK.IF.INBOX:
'
'Is mouse cursor outside the top or bottom of the drop-down menu window frame
'
IF (MOUSEROW<MENU.TOP.ROW) OR (MOUSEROW>MENU.BOTTOM.ROW) THEN
GOTO BARMENU.NOT.IN.BOX
END IF
'
'Is the mouse cursor within the left or right of drop-down menu window frame
'
IF (MOUSECOL>=MENU.TOP.LEFT.COL) AND (MOUSECOL<=MENU.BOTTOM.RIGHT.COL) THEN
GOTO BARMENU.FOUNDIT
END IF
BARMENU.NOT.IN.BOX:
CALL MMCLICK(LFT%,RGT%) 'see if user clicked outside the menu box
CLICK=LFT%+RGT%
IF CLICK THEN 'any button clicked
KP$=CHR$(27) 'Yes, simulate an ESC key press
RETURN
END IF
GOSUB BARMENU.MMCURSORON
GOTO BARMENU.GET.INKEY
'
BARMENU.FOUNDIT:
MSELECT=(MOUSEROW-MENU.TOP.ROW)+1 'mouse cursor is on this menu item
IF MSELECT<>OLD THEN 'are we on the same as before
GOSUB BARMENU.PROCESS 'NO, turnoff Position of Selection Marker
GOSUB BARMENU.TON 'turn on position of Selection Marker
GOSUB BARMENU.MMCURSOROFF
CALL MMCLICK(LFT%,RGT%) 'flush any mouse clicks
GOTO BARMENU.GET.INKEY
END IF
GOSUB BARMENU.MMCURSOROFF
CALL MMCLICK(LFT%,RGT%) 'did user click on the same menu item
CLICK=LFT%+RGT%
IF CLICK THEN 'any mouse buttons pressed?
KP$=CHR$(13) 'YES, simulate an ENTER keypress
RETURN
END IF
BARMENU.GET.INKEY:
KP$=INKEY$ 'was a keyboard key pressed
IF LEN(KP$)=0 THEN 'NO, keep looking for key or mouse click
GOTO BARMENU.GET.PRESS
END IF
RETURN
'
BARMENU.MMCURSORON:
IF BUTTONS%=0 THEN 'is a mouse installed
RETURN 'No
END IF
IF MOUSE.CURSOR=0 THEN 'if the mouse is off
CALL MMCURSORON 'turn it on
MOUSE.CURSOR=-1
END IF
RETURN
BARMENU.MMCURSOROFF:
IF BUTTONS%=0 THEN 'is a mouse installed
RETURN 'no
END IF
IF MOUSE.CURSOR=-1 THEN 'is mouse cursor on
CALL MMCURSOROFF 'turn it off
MOUSE.CURSOR=0
END IF
RETURN
'
'
BARMENU.SOUNDOFF:
SOUND 1000,1
SOUND 1500,2
SOUND 500,1
RETURN
'
BARMENU.DONE:
MENUSLCT%=MENU 'this is the bar menu and drop-down item slected
ITEMSLCT%=MSELECT
'turn off menu bar
BARMENU.DONE2:
GOSUB BARMENU.MMCURSOROFF
WINSEG=0
WINOFF=0
WINSEG=VARSEG(SCR(0))
WINOFF=VARPTR(SCR(0))
CALL RESTWIND(WINDOW.TOP.ROW,WINDOW.TOP.LEFT.COL,WINDOW.BOT.ROW,WINDOW.BOT.RIGHT.COL,WINSEG,WINOFF,RESTWIND.RETURN.CODE)
WINSEG=0
WINOFF=0
WINSEG=VARSEG(BAR.SCR(0))
WINOFF=VARPTR(BAR.SCR(0))
CALL RESTWIND(2,1,2,80,WINSEG,WINOFF,RESTWIND.RETURN.CODE)
ATTR=PRESATTR
CALL FASTPRT(MENULINE$,MENUROW,MENUCOL,ATTR,VIDEO.RETURN.CODE)
ERASE SCR 'erase the DYNAMIC arrays
ERASE BAR.SCR
TEMP.ITEM$=""
MENU.ITEM$=""
REVWORD$=""
END SUB